COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE ARPSER
C00005 00003	 CORBEG NETCMP RCBINP TRBINP ECHOP SUPGAP FLSCHP PUPIBH PUPOBH GOTINT PDL HSTBUF COREND LSNBLK LSNSTS SMRBLK RMRBLK INPBLK
C00007 00004	 CODE TPLTAB TPLMIN WDOTAB WDOMAX EXOPL NIORTS HSTTAB INTBTS CLKTIM IDLECT WORKED MAXIDL
C00011 00005	 ARPSER NWLOTS IPTEST HOSTOK ISLOTS INTRPT
C00015 00006	 GETHST GETHS1 GETPRT PUPNUM PUPNU1 PUPNU2 BADHS1 BADHST BADPRT
C00019 00007	 GETHSN GETHN1 GETHN2 GETHN3
C00021 00008	 GOTHST
C00022 00009	 LOOP NETSER NETSR1 PUPSER PUPSR1 PUPSR2 PUPSR3
C00025 00010	 IACSER PRSTAB
C00027 00011	 DOSR DONTSR
C00029 00012	 WILLSR WONTSR
C00031 00013	 OPTMSG RNDMSG
C00032 00014	 PUPICW PUPICH PUPIC1 PUPIC2 PUPIC3 PUPIC4
C00034 00015	 PUPOCH SNDMSG MSGLUP PUPSND NETERR REJECT SUICID
C00036 ENDMK
C⊗;
TITLE ARPSER
SUBTTL Mark Crispin, SU-AI, October 1981

; Assembly switches

IFNDEF SVRSKT,<SVRSKT←←131>	; default listen port
IFNDEF NPRSKT,<NPRSKT←←27>	; new TELNET protocol port
IFNDEF LOKTMO,<LOKTMO←←5>	; # of 15-second frobs of lock timeout
IFNDEF PDLLEN,<PDLLEN←←50>	; stack length
IFNDEF HSTBFL,<HSTBFL←←=10>	; host name buffer length
IFNDEF FTPUPBUG,<FTPUPBUG←←-1>

; AC definitions.  0→3 are used by NETWRK

X←11 ↔ Y←12 ↔ A←13 ↔ B←14 ↔ C←15 ↔ P←17

PUP←←2				; Pup's I/O channel (NETWRK uses 0 and 1)

; Macro to send a TELNET command

DEFINE TELCMD' (CMDLST) <
 OUTSTR [ASCIZ/⊗'CMDLST'*
/]
 FOR CMD IN (CMDLST) <
  MOVEI CMD
  PUSHJ P,NETOCH
   JRST SUICID
 >;FOR
 PUSHJ P,NETSND
  JRST SUICID
>;DEFINE TELCMD
;⊗ CORBEG NETCMP RCBINP TRBINP ECHOP SUPGAP FLSCHP PUPIBH PUPOBH GOTINT PDL HSTBUF COREND LSNBLK LSNSTS SMRBLK RMRBLK INPBLK

CORBEG←←.			; start of initialized storage

; Protocol flags

NETCMP:	BLOCK 1			; -1 → IAC in progress

FOR @' OPT IN (WILL,WONT,DO,DONT) <
 OPT'P:	BLOCK 1			; -1 → option in effect
>;FOR

RCBINP:	BLOCK 1			; -1 → receiving binary
TRBINP:	BLOCK 1			; -1 → transmitting binary
ECHOP:	BLOCK 1			; -1 → remote echoing
SUPGAP:	BLOCK 1			; -1 → suppressing GA
FLSCHP:	BLOCK 1			; -1 → ignore next byte

; Other storage

PUPIBH:	BLOCK 3			; Pup input buffer header
PUPOBH:	BLOCK 3			; Pup output buffer header
GOTINT:	BLOCK 1			; -1 → got an interrupt
PDL:	BLOCK PDLLEN		; stack

HSTBUF:	BLOCK HSTBFL		; host string buffer

COREND←←.-1			; end of initialized storage

LSNBLK:	1			;Opcode = LISTEN
LSNSTS:	0			;Status
	131			;Local port (GENSYM)
	-1			;Wait for connection
	8			;Bytesize (checked, but not used by PUP)
	-1			;Foreign port
	0			;Host number

SMRBLK:	25			; send Mark
	0			; status word
	6			; Timing Mark Reply

RMRBLK:	26			; read last Mark
	0			; status word
	0			; Mark type returned here

INPBLK:	10			; skip if input available
	0			; status word

;⊗ CODE TPLTAB TPLMIN WDOTAB WDOMAX EXOPL NIORTS HSTTAB INTBTS CLKTIM IDLECT WORKED MAXIDL

DEFINE TPC (CODE,VALUE) <
 CODE←←VALUE
 [ASCIZ/CODE/]
>;TERMIN

; Protocol codes

TPLTAB:
 TPC (SE,360)			; subnegotiation end
 TPC (NOP,361)			; no-op
 TPC (DM,362)			; data mark
 TPC (BRK,363)			; break key
 TPC (IP,364)			; interrupt process
 TPC (AO,365)			; abort output
 TPC (AYT,366)			; are you there?
 TPC (EC,367)			; erase character
 TPC (EL,370)			; erase line
 TPC (GA,371)			; go ahead
 TPC (SB,372)			; subnegotiation
 TPC (WILL,373)			; sender will do
 TPC (WONT,374)			; sender won't do
 TPC (DO,375)			; receiver asked to do
 TPC (DONT,376)			; receiver must not do
 TPC (IAC,377)			; interpret as command
TPLMIN←←<400-<.-TPLTAB>>

; WILL/WONT/DO/DONT codes

WDOTAB:
 TPC (TRNBIN,0)			; transmit binary
 TPC (ECHO,1)			; echo
 TPC (RCP,2)			; reconnect
 TPC (SUPRGA,3)			; suppress GA
 TPC (NAMS,4)			; negotiate approx. message size
 TPC (STATUS,5)			; status option
 TPC (TIMMRK,6)			; timing mark
 TPC (RCTE,7)			; remote controlled trans/echo
 TPC (NAOL,10)			; negotiate output line width
 TPC (NAOP,11)			; negotiate page size
 TPC (NAOCRD,12)		; negotiate output CR
 TPC (NAOHTS,13)		; negotiate output horizontal tab stops
 TPC (NAOHTD,14)		; negotiate output HT
 TPC (NAOFFD,15)		; negotiate output FF
 TPC (NAOVTS,16)		; negotiate output vertical tab stops
 TPC (NAOVTD,17)		; negotiate output VT
 TPC (NAOLFD,20)		; negotiate output LF
 TPC (EXTASC,21)		; Tovar's cretinous idea of extended ASCII
 TPC (LOGOUT,22)		; logout option
 TPC (BM,23)			; byte macro
 TPC (DET,24)			; data entry terminal option
 TPC (SUPDUP,25)		; SUPDUP (not TELNET) protocol
 TPC (SDOTPT,26)		; SUPDUP output option
WDOMAX←←<.-WDOTAB-1>

EXOPL←←377			; extended options (great idea Postel)

; Wonderful network routines

NIORTS←←-1			; network I/O routines for a user program
HSTTAB←←-1			; include host table magic

.INSERT NETWRK.FAI[S,NET]

INTBTS←←<INTINP!INTIMS>

repeat 0,<
CLKTIM←←=60*=60			; time between clock ints (some seconds)
IDLECT:	0			; count of times through main loop while idle
WORKED:	-1			; nonzero if did work this time around main loop
MAXIDL←←3			; idle count at which we go away if no job
>;repeat 0
;⊗ ARPSER NWLOTS IPTEST HOSTOK ISLOTS INTRPT

ARPSER:	TRN
	RESET
	MOVE ['ARPSER']		; set our name
	SETNAM
	SETZM CORBEG		; initialize core
	MOVE [CORBEG,,CORBEG+1]
	BLT COREND
	MOVE P,[IOWD PDLLEN,PDL]
	OUTSTR [ASCIZ/ARPSER started
/]
	INIT PUP,
	 SIXBIT/PUP/
	 PUPOBH,,PUPIBH
	 EXIT
	MOVEI =8		; change byte size in buffer header
	DPB [300600,,PUPIBH+1]
	DPB [300600,,PUPOBH+1]
	INBUF PUP,
	OUTPUT PUP,		; for some reason OUTBUF loses, or did in CHTSER
	SETSTS PUP,		; kill IOIMPM set by previous OUTPUT
	MTAPE PUP,LSNBLK	; open up the connection
	MOVE LSNSTS		; check for MTAPE error
	STATO PUP,467600
	TRNE 77
	 EXIT
	MOVEI 0,INTRPT		; interrupt routine's address
	MOVEM 0,JOBAPR↑		; set up server location
;	CLKINT CLKTIM		; clock ints are used for idle timeout check
	MOVSI 0,(INTBTS)
	INTENB 0,		; turn on interrupts
	LDB 0,[POINT 8,LSNBLK+6,27] ; get foreign PUP host's subnet number
NWLOTS←←60	;LOTS subnet number
	CAIN 0,NWLOTS		; if LOTS, we'll reject the connection
	JRST ISLOTS		; yup, don't provide ARPA access
;JJW 4/84 check for losers who shouldn't be using this service.
	PUSHJ P,MAPHST		;Map in host table
	MOVE 0,LSNBLK+6		;Get PUP host number
	HRLI 0,(NW%SU)		;Make into HOSTS3 format
	PUSHJ P,HSTNUM		;Look them up
	 JRST HOSTOK		;If not there, assume they're OK
	;Unfortunately HSTNUM doesn't necessarily point us to the first
	;address entry in the chain.
ADDADR←←0
ADLSIT←←1
STRADR←←0
	HLRZ 1,ADLSIT(3)	;Get site table entry
	ADD 1,HSTADR
	HRRZ 3,STRADR(1)	;First ADDRESS table entry
	ADD 3,HSTADR
	MOVE 0,ADDADR(3)
IPTEST:	TLNN 0,(NN%IP)		;Do they have an IP address?
	 JRST [			;Yes!
		MOVEI X,[ASCIZ/-Please use your own system's Internet service
/]
		JRST REJECT]
	PUSHJ P,HSTNXA		;Try their next address
	 JRST HOSTOK		;No more, so they're OK
	JRST IPTEST
HOSTOK:
;matching bracket <
	MOVEI X,[ASCIZ/SU-AI SUnet => ARPANET Gateway Version 1.0
/]
	PUSHJ P,SNDMSG
	JRST GETHST

ISLOTS:	MOVEI X,[ASCIZ/Requested service declined
/]
;;	PUSHJ P,SNDMSG	;; use this if you want to give friendly declination
	EXIT

INTRPT:	SETOM GOTINT	; flag an interrupt
	SKIPL 6		; skip if RUN bit on in JBTSTS (from AC 6)
	DISMIS		; don't requeue to TQ if job isn't runnable!
	MOVE X,JOBCNI↑
	TLNE X,(INTINR)
	 OUTSTR [ASCIZ/*INR*
/]
	TLNE X,(INTINS)	; INS int
	 OUTSTR [ASCIZ/*INS*
/]
	MOVSI 1,-1	; requeue into TQ from any queue
	DISMIS 1,]
;⊗ GETHST GETHS1 GETPRT PUPNUM PUPNU1 PUPNU2 BADHS1 BADHST BADPRT

;Get host name or number and port number, set up for CONECT.

GETHST:	MOVEI B,NPRSKT		;Default port number
	MOVEM B,ICPSKT
	PUSHJ P,PUPICW		;Get first character
	PUSHJ P,PUPNUM		;Try to parse a number
	 JRST BADHST		;Blank line
	 JRST GETHSN		;Not numeric, get name
	CAIN 0,"/"		;Check for host/imp form
	 JRST [	PUSHJ P,PUPICW		;Eat "/"
		IORI B,=10⊗=8		;Add network byte for ARPAnet
		LSH B,=16		;Shift net and host into place
		MOVEM B,HOST		;Save in MTAPE block
		PUSHJ P,PUPNUM		;Parse imp number
		 JRST BADHST
		 JRST BADHST
		IORM B,HOST		;Include in host number
		JRST GETHS1]
	;If not host/imp, parse IP host number.  Current char is beginning of
	;second byte in a.b.c.d form, since the "." has been scanned already.
	LSH B,=24		;Shift first byte into place
	MOVEM B,HOST		;Start building host number
	PUSHJ P,PUPNUM		;Get second byte
	 JRST BADHST		;Handle errors
	 JRST BADHST
	LSH B,=16		;Shift into place
	IORM B,HOST		;Combine with rest of number
	PUSHJ P,PUPNUM		;Get third byte
	 JRST BADHST
	 JRST BADHST
	LSH B,=8
	IORM B,HOST
	PUSHJ P,PUPNUM		;Get fourth byte
	 JRST BADHST
	 JRST BADHST
	IORM B,HOST
GETHS1:	CAIE 0,","		;Look for port delimiter
	 JRST GOTHST		;None, use default
GETPRT:	PUSHJ P,PUPICW		;Eat ","
	PUSHJ P,PUPNUM		;Here from above or from GETHSN
	 JRST BADPRT
	 JRST BADPRT
	SKIPL A			;Valid octal number?
	 MOVE B,A		;Yes, use it
	MOVEM B,ICPSKT		;Set up for CONECT
	JRST GOTHST

;Here to parse a number from PUP input, starting with char in 0.  Call:
;	PUSHJ P,PUPNUM
;	<end of line reached>
;	<not a number>
;	<number scanned, octal value in A, decimal in B>
;A is set to -1 if number contains an 8 or 9 or is followed by a decimal point.
PUPNUM:	CAIN 0,"M"-100		;check for <return>
	 POPJ P,
	AOS (P)
	CAIL 0,"0"		;check for non-number
	 CAILE 0,"9"
	  POPJ P,
	AOS (P)
	SETZB A,B
PUPNU1:	SUBI 0,"0"		;make character into digit
	CAIL 0,8		;if can't be octal, A ← -1
	 SETO A,
	JUMPL A,PUPNU2
	LSH A,3
	ADD A,0			;bring in next octal digit
PUPNU2:	IMULI B,=10
	ADD B,0			;bring in next decimal digit
	PUSHJ P,PUPICW
	CAIN 0,"."		;decimal point ends spec and forces decimal
	 JRST [	SETO A,
		PUSHJ P,PUPICW
		POPJ P,]
	CAIL 0,"0"
	 CAILE 0,"9"
	  POPJ P,		;non-numeric, return
	JRST PUPNU1

BADHST:	SKIPA X,[[ASCIZ/-Invalid host number
/]]
BADPRT:	MOVEI X,[ASCIZ/-Invalid port number
/]
	JRST REJECT
;⊗ GETHSN GETHN1 GETHN2 GETHN3

GETHSN:	DMOVE X,[POINT 7,HSTBUF
		 5*HSTBFL]
GETHN1:	IDPB X
	PUSHJ P,PUPICW		; get next character
	CAIN "M"-100		; allow CR too
	 JRST GETHN2
	CAIE ","		; port delimiter?
	 CAIN " "		; terminating space?
	  JRST GETHN2
	SOJG Y,GETHN1		; insert character in buffer
	MOVEI X,[ASCIZ/-Host name too long
/]
	JRST REJECT

GETHN2:	MOVE C,			; save delimiter character
;;JJW 4/84 table already mapped at IPTEST
;;	PUSHJ P,MAPHST		; map in host table
	MOVEI HSTBUF
	PUSHJ P,HSTNAM
	 JRST [	MOVEI X,[ASCIZ/-No such host name
/]
		JRST REJECT]
	 JRST [	MOVEI X,[ASCIZ/-Ambiguous host name
/]
		JRST REJECT]
	MOVEM 0,HOST
;Before proceeding, make sure this host isn't accessible directly via PUP.
;This is to punish the losers who get here from a Tip or other host by typing
;an abbreviated host name.
GETHN3:	GETNET X,0
	CAMN X,[NW%SU]		; Ethernet address?
	 JRST [	MOVEI X,[ASCIZ/-Please type the full host name
/]
		JRST REJECT]
	PUSHJ P,HSTNXA		; Try alternate addresses
	 CAIA			; No more, this host is OK
	JRST GETHN3
	PUSHJ P,UNMHST		; unmap host table
	CAIN C,","		; have port?
	 JRST GETPRT
;falls through
;⊗ GOTHST

;Here with HOST and ICPSKT set up to make connection.

GOTHST:	PUSHJ P,CONECT
	 JRST [	TRNE 77		; UUO lossage?
		 JRST NETERR
		TLNN (CLSR)
		 SKIPA X,[[ASCIZ/-Time out
/]]
		  MOVEI X,[ASCIZ/-Refused
/]
		JRST REJECT]
	 JRST [	TRNN IODEND!IOIMPM
		 JRST NETERR
		MOVEI X,[ASCIZ/-Host closed connection
/]
		JRST REJECT]
	MOVEI X,[ASCIZ/+/]
	PUSHJ P,SNDMSG

; Send ARPANET protocol commands and enter main loop

	LOCK			; lock us in core
	CAIE B,NPRSKT
	 JRST LOOP		; no, don't bother with initial commands
	TELCMD <IAC,DO,ECHO,IAC,DO,SUPRGA>
	SETOM ECHOP
	SETOM SUPGAP
;	JRST LOOP
;⊗ LOOP NETSER NETSR1 PUPSER PUPSR1 PUPSR2 PUPSR3

; Main program loop

LOOP:	SKIPN GOTINT		; got an interrupt?
	 IMSTW [INTBTS]		; wait for one to happen
	INTMSK [0]		; mask off interrupts
	SETZM GOTINT
	MOVEI 2			; check connection status
	MTAPE NET,
	TLNN 1,(CLSS!CLSR)	; send side gronked?
	 TLNE 2,(CLSS!CLSR)	; receive side?
	  JRST SUICID
;	JRST NETSER

; ARPANET server

NETSER:	PUSHJ P,NETICH		; get character from ARPANET
	 JRST SUICID		; I/O error
	 JRST PUPSER		; ARPANET input buffer empty
	AOSG NETCMP		; IAC in progress?
	 JRST IACSER
	FOR @' OPT IN (WILL,WONT,DO,DONT) <
	 AOSG OPT'P
	  JRST OPT'SR
	>;FOR
	CAIN IAC		; network command?
	 JRST [	SETOM NETCMP	; remember that one is coming
		JRST NETSER]
NETSR1:	PUSHJ P,PUPOCH
	JRST NETSER		; try for more user characters

; Pup server

PUPSER:	PUSHJ P,PUPSND		; force the buffer out
PUPSR1:	PUSHJ P,PUPICH
	 JRST [	PUSHJ P,NETSND	; send the buffer out
		 JRST SUICID
		STATZ PUP,IODEND
		 JRST SUICID
		JRST LOOP]
	CAIE "M"-100		; CR?
	 JRST PUPSR2
	PUSHJ P,NETOCH
	 JRST SUICID
	SKIPE TRBINP
	 TDZA			; transmitting binary, send NUL
	  MOVEI "J"-100		; no binary, send LF
PUPSR2:	CAIE IAC		; sending edit-rubout?
	 JRST PUPSR3
	PUSHJ P,NETOCH		; yes, double it
	 JRST SUICID
	MOVEI IAC
PUPSR3:	PUSHJ P,NETOCH		; send it to the network
	 JRST SUICID
	JRST PUPSR1
;⊗ IACSER PRSTAB

; IAC server

IACSER:	OUTSTR [ASCIZ/*IAC /]
	CAIGE TPLMIN		; big enough?
	 JRST [	PUSHJ P,RNDMSG	; unknown, flush
		JRST NETSER]
	MOVE 1,
	OUTSTR @TPLTAB-TPLMIN(1)
	CAIE IAC
	 CAIGE WILL
	  OUTSTR [ASCIZ/*
/]
	XCT PRSTAB-TPLMIN(1)
	JRST NETSER

DEFINE NC (CODE,SERVER) <
 IFN <.+TPLMIN-PRSTAB-CODE>,<.FATAL Lossage at CODE>
 SERVER
>;DEFINE NC

PRSTAB:				; Protocol command server table

NC SE,<JRST NETSER>
NC NOP,<JRST NETSER>
NC DM,<JRST NETSER>
NC BRK,<JRST NETSER>
NC IP,<JRST NETSER>
NC AO,<JRST NETSER>
NC AYT,<JRST NETSER>
NC EC,<JRST NETSER>
NC EL,<JRST NETSER>
NC GA,<JRST NETSER>
NC SB,<JRST NETSER>
NC WILL,<SETOM WILLP>
NC WONT,<SETOM WONTP>
NC DO,<SETOM DOP>
NC DONT,<SETOM DONTP>
NC IAC,<JRST NETSR1>
;⊗ DOSR DONTSR

; IAC DO/DONT

DOSR:	PUSHJ P,OPTMSG
	CAIN TRNBIN		; binary from host
	 JRST [	SKIPE TRBINP	; catch protocol loops
		 JRST NETSER
		SETOM TRBINP
		TELCMD <IAC,WILL,TRNBIN>
		JRST NETSER]
	CAIN TIMMRK		; silly Timing Mark?
	 JRST [	TELCMD <IAC,WILL,TIMMRK>
		JRST NETSER]

; Not an option we like, refuse it

	PUSH P,
	OUTSTR [ASCIZ/⊗IAC WONT/]
	MOVEI IAC
	PUSHJ P,NETOCH
	 JRST SUICID
	MOVEI WONT
	PUSHJ P,NETOCH
	 JRST SUICID
	POP P,
	PUSHJ P,OPTMSG
	PUSHJ P,NETOCH
	 JRST SUICID
	PUSHJ P,NETSND
	 JRST SUICID
	JRST NETSER

DONTSR:	PUSHJ P,OPTMSG
	CAIN TRNBIN
	 SKIPN TRBINP
	  JRST NETSER
	SETZM TRBINP
	TELCMD <IAC,WONT,TRNBIN>
	JRST NETSER
;⊗ WILLSR WONTSR

; IAC WILL/WONT

WILLSR:	PUSHJ P,OPTMSG
	CAIN TRNBIN		; binary to host
	 JRST [	SKIPE RCBINP	; catch protocol loops
		 JRST NETSER
		SETOM RCBINP
		TELCMD <IAC,DO,TRNBIN>
		JRST NETSER]
	CAIN ECHO		; remote echo (what a win!)
	 JRST [	SKIPE ECHOP	; catch protocol loops
		 JRST NETSER
		SETOM ECHOP
		TELCMD <IAC,DO,ECHO>
		JRST NETSER]	; command, we always accept it
	CAIN SUPRGA		; suppress GA?
	 JRST [	SKIPE SUPGAP	; command or reply?
		 JRST NETSER
		SETOM SUPGAP
		TELCMD <IAC,DO,SUPRGA>
		JRST NETSER]

; Not an option we like, refuse it

	PUSH P,
	OUTSTR [ASCIZ/⊗IAC DONT/]
	MOVEI IAC
	PUSHJ P,NETOCH
	 JRST SUICID
	MOVEI DONT
	PUSHJ P,NETOCH
	 JRST SUICID
	POP P,
	PUSHJ P,OPTMSG
	PUSHJ P,NETOCH
	 JRST SUICID
	PUSHJ P,NETSND
	 JRST SUICID
	JRST NETSER

WONTSR:	PUSHJ P,OPTMSG
	CAIN TRNBIN
	 JRST [	SKIPN RCBINP
		 JRST NETSER
		SETZM RCBINP
		TELCMD <IAC,DONT,TRNBIN>
		JRST NETSER]
	CAIN ECHO
	 JRST [	SKIPN ECHOP
		 JRST NETSER
		SETZM ECHOP	; back to lossage
		TELCMD <IAC,DONT,ECHO>
		JRST NETSER]
	CAIN SUPRGA
	 SKIPL SUPGAP
	  JRST NETSER		; protocol violator
	SETZM SUPGAP
	TELCMD <IAC,DONT,SUPRGA>
	JRST NETSER
;⊗ OPTMSG RNDMSG

; WILL/WONT/DO/DONT option message

OPTMSG:	CAIN EXOPL
	 JRST [	OUTSTR [ASCIZ/ EXOPL*
/]
		POPJ P,]
	OUTCHR [" "]
	CAILE WDOMAX
	 JRST RNDMSG
	MOVE 1,
	OUTSTR @WDOTAB(1)
	OUTSTR [ASCIZ/*
/]
	POPJ P,

RNDMSG:	IDIVI 100	; output the octal for an unknown message
	ADDI "0"
	OUTCHR
	IDIVI 10
	ADDI 1,"0"
	OUTCHR 1
	ADDI 2,"0"
	OUTCHR 2
	OUTSTR [ASCIZ/*
/]
	POPJ P,
;⊗ PUPICW PUPICH PUPIC1 PUPIC2 PUPIC3 PUPIC4

; Get character from Ethernet

PUPICW:	TDZA 2,2
PUPICH:	 SETO 2,
PUPIC1:	SOSLE PUPIBH+2		; data available?
	 JRST PUPIC4
	JUMPE 2,PUPIC2
	HRRZ 1,PUPIBH
	HRRZ 1,(1)
	SKIPGE (1)		; anything in further buffers?
	 JRST PUPIC2
	MTAPE PUP,INPBLK	; no - new packet available?
	 POPJ P,
PUPIC2:	IN PUP,			; yes - get it
	 JRST PUPIC3
	GETSTS PUP,1
	TRZN 1,IODEND!IODTER	; End seen?
	 TRZN 1,IOBKTL		; Mark seen?
	  JRST SUICID
	SETSTS PUP,(1)		; yes, clear error status
	MTAPE PUP,RMRBLK
	 TRN
	MOVE RMRBLK+2		; get Mark type
	CAIN 5			; Timing Mark?
	 JRST [	MTAPE PUP,SMRBLK; yes, send Timing Mark Reply
		 JRST SUICID
		JRST PUPIC1]
	CAIL 2			; between Line Width
	 CAILE 4		; and Terminal Type?
	  JRST PUPIC1		; no
	SETOM FLSCHP		; yes, ignore next byte
	JRST PUPIC1

PUPIC3:	MOVE 1,PUPIBH		;Get address of buffer
	ADD 1,1(1)		;Address last word in buffer
	LDB 1,[POINT 4,1(1),35]	;Get padding information
	SKIPG 1,[0↔-1↔2↔-2↔4↔5↔6↔-3↔10↔11↔12↔13↔14↔15↔16↔17](1)
				;Should NEVER skip
	  ADDB 1,PUPIBH+2	;Update byte count
PUPIC4:	ILDB PUPIBH+1		; get the byte
	AOSN FLSCHP		; ignore this byte?
	 JRST PUPIC1		; yes, get next
	SKIPE 2
	 AOS (P)
	POPJ P,
;⊗ PUPOCH SNDMSG MSGLUP PUPSND NETERR REJECT SUICID

; Send character to Ethernet

PUPOCH:	SOSG PUPOBH+2
	 PUSHJ P,PUPSND
	IDPB PUPOBH+1
IFN FTPUPBUG,<
	MOVE 1,PUPOBH+2
	CAIG 1,600
	 PUSHJ P,PUPSND
>;IFN FTPUPBUG
	POPJ P,

; Send a message, s.p. in X

SNDMSG:	TLOA X,440700		; set up b.p.
MSGLUP:	 PUSHJ P,PUPOCH
	ILDB X
	JUMPN MSGLUP		; continue until a null hit
PUPSND:	MOVE A,PUPOBH+2
	ANDI A,3
	MOVE A,[0
		1
		3
		7](A)
	SKIPLE PUPOBH		; set fill bits only if buffers are setup properly
	DPB A,[	POINT 4,@PUPOBH+1,35 ]
	OUT PUP,
	 POPJ P,
	OUTSTR [ASCIZ/Pup output error/]
	STATZ PUP,IODTER
	 OUTSTR [ASCIZ/ - timeout/]
	JRST SUICID		; connection died

; "Impossible network errors"

NETERR:	MOVEI X,[ASCIZ/-ARPANET lossage, try again
/]

; General network errors

REJECT:	PUSHJ P,SNDMSG
	MOVEI 2
	SLEEP
	CLOSE PUP,
;	JRST SUICID

; Here to suicide on network errors

SUICID:	RELEASE PUP,
	RELEASE NET,
	RESET
	EXIT

...LIT:	LIT

END ARPSER